home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1999 March / EnigmA AMIGA RUN 35 (1999)(G.R. Edizioni)(IT)[!][issue 1999-03].iso / earcd / grafica / amicad / arexx / selectnet.amicad < prev    next >
Text File  |  1999-01-01  |  4KB  |  200 lines
  1. /* Sélection d'une netlist */
  2. /* $VER: NetList 1.00 (14-07-98) */
  3. /* $VER: NetList 1.01 (13/01/99) Modif test clic liaison */
  4. /* $VER: 1.02 (© R.Florac, 6/9/99) Ajout UNLOCK */
  5. /* Ne teste que les lignes horizontales ou verticales */
  6.  
  7. options results     /* indispensable pour récupérer le résultat des macros */
  8.  
  9. signal on error     /* pour l'interception des erreurs */
  10. signal on syntax
  11.  
  12. 'FIRSTSEL'; i=result
  13. if result~=0 then do
  14.     'NEXTSEL(FIRSTSEL)'
  15.     if result~=0 then i=0
  16. end
  17.  
  18. if i=0 then do
  19.     'PICKOBJ("Cliquez sur la liaison à tester")'
  20.     i=result
  21. end
  22.  
  23. if i<=0 then exit
  24.  
  25. /* Test des liaisons */
  26. j=1; nets=0; net.0=""
  27. 'TITLE("Lecture des liaisons en cours..."):LOCK(-1):OBJECTS(-1)'; objets=result
  28.  
  29. /* Initialisation de l'appartenance des objets à une équipotentielle */
  30. net.=-1
  31.  
  32. 'TYPE(O='i')'
  33. if result=2 then do
  34.     'UNMARK(-1):TEST(O)'
  35.     if result=0 then do
  36.     'COORDS(O)'             /* Marquage du fil */
  37.     parse var result x0','y0','x1','y1
  38.     call test_ligne(x0,y0,objets)
  39.     call test_ligne(x1,y1,objets)
  40.     end
  41. end
  42. else do
  43.     'MESSAGE("Sélection incorrecte"):UNLOCK(-1)'
  44.     exit
  45. end
  46.  
  47. 'TITLE("Test des jonctions...")'
  48. m=1
  49. do while m>0
  50.     m=0
  51.     i=1
  52.     do while i>0
  53.     'OO=FINDOBJ('i',7,-1,-1)'; i=result
  54.     if i>0 then do
  55.         'TEST(OO)'
  56.         if result=0 then do
  57.         'COL(OO)'; x0=result
  58.         'LINE(OO)'; y0=result
  59.         n=test_jonction(x0,y0,objets)
  60.         if n=1 then do        /* la jonction appartient au net */
  61.            'MARK(OO)'
  62.             call marquer_ligne(x0,y0,objets)
  63.             m=1
  64.         end
  65.         end
  66.         if i=objets then i=0
  67.         else i=i+1
  68.     end
  69.     end
  70. end
  71.  
  72. 'TITLE("Recherche des masses...")'
  73. label=""
  74. do i=1 to objets
  75.     'O=FINDPART('i',"MASSE")'; i=result
  76.     if i>0 then do
  77.     j=connexion_broche(i,1)
  78.     if j>0 then do
  79.         'TEST('j')'
  80.         if result=1 then do
  81.         label=0
  82.         leave i
  83.         end
  84.     end
  85.     i=i+1
  86.     end
  87.     else leave
  88. end
  89.  
  90. if label="" then do
  91.     'TITLE("Recherche des labels...")'
  92.     do i=1 to objets
  93.     'TYPE(O='i')'
  94.     if result=4 | result=12 | result=11 then do
  95.         'ABS(FINDLINE(1,COL(O),LINE(O)))'; j=result
  96.         if j>0 then do
  97.         'TEST('j')'
  98.         if result=1 then do
  99.             'READTEXT(O)'; label=result; leave i
  100.         end
  101.         end
  102.     end
  103.     end
  104. end
  105.  
  106. if label="" then do
  107.     'TITLE("Recherche des alimentations...")'
  108.     do i=1 to objets
  109.     'O=FINDPART('i',"ALIMENTATION")'; i=result
  110.     if i>0 then do
  111.         j=connexion_broche(i,1)
  112.         if j>0 then do
  113.         'TEST('j')'
  114.         if result=1 then do
  115.             'READTEXT(GETVAL(O))'; label=result; leave i
  116.         end
  117.         end
  118.         i=i+1
  119.     end
  120.     else leave
  121.     end
  122. end
  123.  
  124. 'TITLE("")'
  125. if label~="" then 'MESSAGE("Équipotentielle 'label'")'
  126. 'UNLOCK(-1)'
  127. exit
  128.  
  129. test_ligne: procedure expose net.
  130.     parse arg x0,y0,objets
  131.     o=1
  132.     do until o=0
  133.     'X=FINDOBJ('o',2,'x0','y0')'; o=result
  134.     if o>0 then do
  135.         'IF(TEST(X),0,MARK(X):COORDS(X))'
  136.         if result~=0 then do
  137.         net.o=1
  138.         parse var result x1','y1','x2','y2
  139.         if x0=x1 & y0=y1 then call test_ligne(x2,y2,objets)
  140.         else call test_ligne(x1,y1,objets)
  141.         end
  142.         if o=objets then return
  143.         o=o+1
  144.     end
  145.     end
  146.     return
  147.  
  148. marquer_ligne: procedure expose net.
  149.     parse arg x0,y0,objets
  150.     o=1
  151.     do until o=0
  152.     'X=ABS(FINDLINE('o','x0','y0'))'; o=result
  153.     if o>0 then do
  154.         'IF(TEST(X),0,MARK(X):COORDS(X))'
  155.         if result~=0 then do
  156.         net.o=1
  157.         parse var result xl','yl','x1','y1
  158.         call test_ligne(xl,yl,objets)
  159.         call test_ligne(x1,y1,objets)
  160.         end
  161.         if o=objets then return
  162.         o=o+1
  163.     end
  164.     end
  165.     return
  166.  
  167. test_jonction: procedure expose net.
  168.     parse arg xj,yj,objets
  169.     obj=1
  170.     do while obj>0
  171.     'X=ABS(FINDLINE('obj','xj','yj'))'; obj=result
  172.     if net.obj=1 then return 1
  173.     if obj=0 then return 0
  174.     if obj=objets then return 0
  175.     obj=obj+1
  176.     end
  177.     return 0
  178.  
  179. connexion_broche: procedure
  180.     parse arg objet,broche
  181.     'PINCOL(O='objet',B='broche')'; xj=result
  182.     'PINLINE(O,B)'; yj=result
  183.     'FINDOBJ(1,2,'xj','yj')'; xl=result     /* Il y a t'il une ligne qui part de la broche? */
  184.     if xl>0 then return xl
  185.     'FINDLINE(1,'xj','yj')'; xl=result      /* Il y a peut être une ligne qui passe SUR la broche... */
  186.     if xl<=0 then return 0
  187.     'FINDOBJ(1,7,'xj','yj')'                /* Il doit alors y avoir une jonction */
  188.     if result>0 then return xl
  189.     return 0
  190.  
  191. /* Traitement des erreurs, interruption du programme */
  192. syntax:
  193. erreur=RC
  194. 'MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'"):UNLOCK(-1)'
  195. exit
  196.  
  197. error:
  198. 'MESSAGE("Erreur en ligne 'SIGL'"):UNLOCK(-1)'
  199. exit
  200.